Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d17/pslabel.arc/PSLABEL.PAS

Pascal/Delphi Source File | 1986-11-08 | 5KB | 161 lines

program PrintPS;  { print a graphic on labels }
   { All commands are for an Epson FX-185 printer }

{ Copyright (c) 1986   Clint Hastings - Salt Lake City, Utah }
{ Permission granted for all use of a non-commercial nature. }

type  CPUreg = record  case boolean of
                 false: (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
                 true:  (al,ah,bl,bh,cl,ch,dl,dh          : byte)
               end;
      PSpic = array[0..51,0..10] of byte;

{ the lines can be spaced to suit your needs but they aren't full-height
  lines, so don't use them all. These are the default lines - just hit
  <RETURN> instead of typing in new lines. }

const LabelLine : array[0..17] of string[40] =
                 ('',
                  '',
                  '         Default Lines are in the',
                  '',
                  '',
                  '',
                  '         program. Put your address',
                  '',
                  '',
                  '',
                  '         there to avoid retyping.',
                  '',
                  '',
                  '',
                  '',
                  '',
                  '',
                  '');

var  reg : CPUreg;
     filename : string[80];
     g, n, Graphic, NumLabels,
     Col, Row, x, len1, len2 : integer;
     pf : file of PSpic;
     pic : PSpic;
     FileDrive, sameG : string[1];
     same : boolean;

procedure PrintPSGraphic(n : integer);
const BitMask : array[0..7] of byte =
           ($80, $40, $20, $10, 8, 4, 2, 1);

var  TempY : array[0..3] of byte;
     temp,b : byte;
     buf : array[0..127] of byte;
     BufPtr, step, y, x, p, i, j : integer;
     ch : char;

begin
  for y := 0 to 12 do BEGIN       { 52 dots @ 4 dots per row = 13 rows }
  if LabelLine[y] <> '' then
      write(lst,LabelLine[y],#13);
    write(lst,#27'L',chr(len1),chr(len2));
    for x := 0 to 10 do BEGIN
           for i := 0 to 3 do  { get next line }
              TempY[i] := pic[ y*4+i, x];
           for j := 0 to 7 do BEGIN
             temp := 0;
             for i := 0 to 3 do
               if (TempY[i] AND (1 shl (7-j)) ) <> 0 then
                   temp := temp + (1 shl (3-i));
             write(lst,chr(temp))
             END;
      END;
    writeln(lst)
    END;
  for y := 13 to 17 do BEGIN     { spacing for next label }
      if LabelLine[y] <> '' then
          write(lst,LabelLine[y],#13);
    writeln(lst)
    END;
  if not same then read(pf,pic);  { if not all the same graphic, }
end;                              { then fetch the next one here }

procedure InfoScreen;
begin
  gotoxy(3,1);
  writeln('Copyright (c) 1986 - Clint Hastings - Salt Lake City, Utah');
  gotoxy(5,3);
  writeln('**********  PRINTSHOP  LABEL  MAKER  ****************');
  writeln;
  writeln('    This program lets you print mailing labels using');
  writeln('    PrintShop graphics for decoration. You can print');
  writeln('    as many labels as you want. The graphic can be the');
  writeln('    same on each label, or can move sequentially through');
  writeln('    the graphic file starting at a given graphic. It can');
  writeln('    use the default graphic files - hit <RETURN> in response');
  writeln('    to graphic file?. You can use the library disk by typing');
  writeln('    1 or 2. Graphic file drive - type A,B,C, etc., but no');
  writeln('    colon is necessary.    Have fun!!!');
  writeln('NOTE:');
  writeln('    Printer codes are for Epson FX printers. Source code');
  writeln('    in Turbo Pascal is provided for you to make necessary');
  writeln('    changes for other printers.');
  writeln;
  writeln
end;

procedure Setup;
var  line : string[40];
begin
  write(lst,#27'A'#4);     { 4 dots high - line spacing }
  len1 := (11*8) mod 256;  { calculate number of dots per line }
  len2 := (11*8) div 256;

  InfoScreen;

  writeln('    PRINTSHOP LABEL MAKER');
  write(#13#10'    Number of Labels to print ? ');
  readln(NumLabels);
  write(#13#10'    Starting graphic # to print ? ');
  readln(Graphic);
  Graphic := Graphic - 1;
  write(#13#10'    Graphic file (0,1,2) ? ');
  readln(FileName);
  write(#13#10'    Graphic file drive ? ');
  readln(FileDrive);
  if FileName = '' then  FileName := FileDrive + ':' + 'GrData.Dat'
                   else  FileName := FileDrive + ':GrLib' + FileName + '.dat';

  assign(pf,FileName);
  {$I-}  reset(pf);  {$I+}
  if IOresult <> 0 then HALT;

  seek(pf,Graphic);
  read(pf,pic);

  writeln;
  writeln('3 label lines :');
  write('    ');
  readln(line);
  if line <> '' then BEGIN
      LabelLine[2] := '         ' + line;
      readln(line);
      LabelLine[6] := '         ' + line;
      readln(line);
      LabelLine[10] := '         ' + line;
      END;
  write('All the same graphic (y/n) ? ');
  readln(sameG);
  same := (sameG <> 'n') and (sameG <> 'N');
end;

begin
  ClrScr;
  Setup;

  for n := Graphic to Graphic-1+NumLabels do  PrintPSGraphic(n);

  close(pf);
  write(lst,#27'2');  { restore regular line spacing }
end.